HPAVC/HPAVC CD-ROM.iso/BOI200P.ZIP/ASYNC.PAS

Pascal/Delphi Source File | 1992-12-14 | 13KB | 395 lines

{ $D-}  { Debug Information Off }
{ $S-}  { Stack Checking Off    }
{$V-}  { String Checking Off   }
{$F+}

Unit Async;
{ Part of BBS Onliner Interface }
{ Copyright (C) 1990, 1992 Andrew J. Mead
  All Rights Reserved. }

{ original version 9/5/90
  history found in IOLIB.PAS
  4/ 7/91  DropCarrier modified (dolocal condition added)
  4/16/91  CallOldInt added

  For more information regarding FOSSIL function calls, you can obtain
  PASFOSS1.ZIP from me.  It is a FreeWare Pascal source API of FOSSIL
  revision 5 calls.

}

INTERFACE

Function CARRIER : boolean;                  { Carrier Detect function }
Procedure DROPCARRIER;                       { Drop Carrier }
Procedure ASYNCINT; Interrupt;           { won't work if not in interface??? }
Procedure SENDCHAR(outchar : char);          { Comport Output Routine }
Function CHARREADY : boolean;                { Character Ready for Input }
Function READBUFFER : char;                  { Get Character from buffer }
Procedure CLEARINBUFFER;                     { Empty input buffer }
Procedure SETBUFFERSIZE(newsize : integer);  { Set buffer size, defaul = 1k }
Function INTINIT : byte;                     { Install Comport Interrupt }

IMPLEMENTATION

Uses
  boidecl,
  iolib,
  dos;

Const
  null         = #0;
  icom_maxbuff = 1024;  { circular input buffer maximum size }

                  { UART - Universal Asynchronious Receiver/Transmitter    }
  THRoff  = $00;  { 8250 UART Transmitter Holding Register offset          }
  RBRoff  = $00;  { 8250 UART Receiver Buffer Register offset              }

  DLLoff  = $00;  { 8250 UART Divisor Latch Least Significant Byte offset  }
  DLMoff  = $01;  { 8250 UART Divisor Latch Most Significant Byte offset   }

  IERoff  = $01;  { 8250 UART Interrupt Enable Register offset             }
  IIRoff  = $02;  { 8250 UART Interrupt Identification Register offset     }
  LCRoff  = $03;  { 8250 UART Line Control Register offset                 }
  MCRoff  = $04;  { 8250 UART Modem Control Register offset                }
  LSRoff  = $05;  { 8250 UART Line Status Register offset                  }
  MSRoff  = $06;  { 8250 UART Modem Status Register offset                 }

  { IRQ0..7 }
  PICCMD  = $20;  { 8259A Programmable Interrupt Controller Port (Command) }
  PICMSK  = $21;  { 8259A Programmable Interrupt Controller Port (Mask)    }
  { IRQ8..15 }
  PIC2CMD = $A0;  { cascade 8259A PIC (Command)                            }
  PIC2MSK = $A1;  { cascade 8259A PIC (Mask)                               }

  RTSbit  = $20;  { Ready To Send bit in LSR }
  CTSbit  = $10;  { Clear To Send bit in MSR }
  DCDbit  = $80;  { Data Carrier Detect (RLSD) bit in MSR }
  DCval   = $08;  { changes carrier detect bit in MSR }

  fossint = $14;

Type
  portbufftype = array [1..icom_maxbuff] of char;

Var
  icom_portbuffer  : portbufftype;  { Circular input buffer }
  icom_bufflimit   : integer;       { Current maximum buffer size }
  icom_buffsize    : integer;       { Number of character in buffer }
  icom_buffend     : integer;       { Index pointing to last char in buffer }
  icom_buffstart   : integer;       { Index pointing to first char in buffer }
  icom_asyncvector : pointer;       { original interrupt vector }
  IIRstatus        : byte;          { 8250 UART IIR status byte }
  LSRstatus        : byte;          { 8250 UART LCR status byte }

  foss_regs        : registers;

Procedure CALLOLDINT(sub : pointer);
  begin {* CallOldInt *}
    Inline($9C/            { PushF }
        $FF/$5E/$06)       { Call DWord PTR [BP + 6] }
  end;  {* CallOldInt *}

Function CARRIER : boolean;
  var
    ctemp : boolean;
{ This function will return 'true' if
  a) program is in 'local' mode
  b) carrier detect is disabled (command line option)
  c) carrier (phone line) is detected. }

  begin {* fCarrier *}
    if boi_local or (not boi_checkcd) then Carrier := true
    else
      begin
        case boi_cmode of
            com_internal :
                ctemp := ((port[boi_portadd + MSRoff] and DCDbit) = DCDbit);
            com_fossil :
              begin
                foss_regs.AH := $03;
                foss_regs.DX := boi_portnum;
                Intr(fossint,foss_regs);
                ctemp := foss_regs.AL and $80 = $80
              end
          end;
        if not ctemp then boi_cdlost := true;
        Carrier := ctemp
      end
  end;  {* fCarrier *}

Procedure DROPCARRIER;
{ This function will force the modem to hang up the phone.}
  const
    DTRlow = $00;  { force DTR low value }

  var
    timebase : longint;

  begin {* DropCarrier *}
    if not boi_local then
      begin
        boi_cdlost := true;
        case boi_cmode of
            com_internal :
              begin
                timebase := boi_timer;
                repeat port[boi_portadd + MCRoff] := DTRlow
                until boi_timer >= timebase + 36 { force DTR low for 2 seconds }
              end;
            com_fossil :
              begin
                foss_regs.AH := $06;
                foss_regs.AL := DTRlow;
                foss_regs.DX := boi_portnum;
                Intr(fossint,foss_regs)
              end
          end
      end
  end;  {* DropCarrier *}

Procedure ASYNCINT;
  begin {* AsyncInt *}
    Inline($FB);   { STI }
    if boi_tintr then BOI_Crit;
    IIRstatus := port[boi_portadd + IIRoff];  { read IIR status }
    if ((IIRstatus and $06) = $04) then   { check to see if character waiting }
      begin                               { place character in buffer }
        if icom_buffsize < icom_bufflimit then
          begin
            icom_portbuffer[icom_buffend] := Chr(Port[boi_portadd + RBRoff]);
            if icom_buffend < icom_bufflimit then
                Inc(icom_buffend)
            else icom_buffend := 1;
            Inc(icom_buffsize)
          end
        else LSRstatus := Port[boi_portadd + RBRoff] { clear LSR status byte }
      end
{   else CallOldInt(asyncvector); } { call previous interrupt for processing }
    else if ((IIRstatus and $06) = $06) then
        LSRstatus := Port[boi_portadd + RBRoff];
    if boi_tintr then BOI_Safe;
    Inline($FA);   { CLI }
    Port[PICCMD] := $20;                      { reset 8259A PIC }
    if boi_cascade then Port[PIC2CMD] := $20  { reset cascade 8259A PIC }
  end;  {* AsyncInt *}

Procedure SENDCHAR(outchar : char);
  var
    charsent : boolean;

  begin {* SendChar *}
    boi_stall := 1;
    case boi_cmode of
        com_internal :
          begin
            while (port[boi_portadd + LSRoff] and
                RTSbit <> RTSbit) or   { <- UART ready }
                ({ baudlock and } { /B switch is now assumed }
                (port[boi_portadd + MSRoff] and CTSbit <> CTSbit)) do
              begin                           { ^^ modem ready ^^ }
                if not in_dos^ then BOI_Wait;
                if not Carrier then DoTimeOut(false)
                else if boi_stall >= 1092 then DoTimeOut(false)
                       { timeout after 60 seconds, assume carrier is lost }
              end;
            port[boi_portadd + RBRoff] := Ord(outchar)  { send character }
          end;
        com_fossil :
          begin
            repeat
              begin
                foss_regs.AH := $0B;
                foss_regs.AL := Ord(outchar);
                foss_regs.DX := boi_portnum;
                Intr(fossint,foss_regs);
                charsent := foss_regs.AX = $0001;
                if not charsent then
                  begin
                    if (not Carrier) or (boi_stall > 1092) then
                        DoTimeOut(false);
                    if not in_dos^ then BOI_Wait
                  end
              end
            until charsent
          end
      end
  end;  {* SendChar *}

Function CHARREADY : boolean;
  begin {* fCharReady *}
    case boi_cmode of
        com_internal : CharReady := icom_buffsize > 0;
        com_fossil :
          begin
            foss_regs.AH := $03;
            foss_regs.DX := boi_portnum;
            Intr(fossint,foss_regs);
            CharReady := foss_regs.AH and $01 = $01
          end
      end
  end;  {* fCharReady *}

Function READBUFFER : char;
  var
    rb : char;

  begin {* fReadBuffer *}
    if CharReady then case boi_cmode of
        com_internal :
          begin
            rb := icom_portbuffer[icom_buffstart];
            if icom_buffstart < icom_bufflimit then
                Inc(icom_buffstart) else icom_buffstart := 1;
            Dec(icom_buffsize);
            ReadBuffer := rb
          end;
        com_fossil :
          begin
            foss_regs.AH := $02;
            foss_regs.DX := boi_portnum;
            Intr(fossint,foss_regs);
            ReadBuffer := Chr(foss_regs.AL)
          end
      end
    else ReadBuffer := null
  end;  {* fReadBuffer *}

Procedure CLEARINBUFFER;
  begin {* ClearInBuffer *}
    case boi_cmode of
        com_internal :
          begin
            icom_buffend := icom_buffstart;
            icom_buffsize := 0
          end;
        com_fossil :
          begin
            foss_regs.AH := $0A;
            foss_regs.DX := boi_portnum;
            Intr(fossint,foss_regs)
          end
      end
  end;  {* ClearInBuffer *}

Procedure SETBUFFERSIZE(newsize : integer);
  begin {* SetBufferSize *}
    if (newsize > 1) and (newsize <= icom_maxbuff) then
      begin
        icom_buffstart := 1;
        ClearInBuffer;
        icom_bufflimit := newsize
      end;
  end;  {* SetBufferSize *}

var
  intexit : pointer;

Procedure ASYNCEND;
  begin {* AsyncEnd *}
    exitproc := intexit;
    Inline($FA);  { CLI }
{}  boi_portstatus := false;
    SetIntVec(boi_portint,icom_asyncvector); { re-install old interrupt vector }
    Port[PICCMD] := $20;                      { reset 8259A PIC }
    if boi_cascade then Port[PIC2CMD] := $20; { reset cascade 8259A PIC }
    Inline($FB)   { STI }
  end;  {* AsyncEnd *}

Procedure FOSSILEND;
  begin {* FOSSILEnd *}
    exitproc := intexit;
    foss_regs.AH := $05;
    foss_regs.DX := boi_portnum;
    Intr(fossint,foss_regs)
  end;  {* FOSSILEnd *}

Function INTINIT : byte;
  var
    initerr : byte;

  Procedure ASYNCINIT;
    var
      inittemp : byte;                 { temporary data holding variable }

    begin {* fIntInit,AsyncInit *}
      intexit := exitproc;
      exitproc := @AsyncEnd;
      FillChar(icom_portbuffer,SizeOf(icom_portbuffer),32);
      icom_buffend   := 1;
      icom_buffstart := 1;
      icom_buffsize  := 0;
      icom_bufflimit := icom_maxbuff;
  {}  boi_portstatus := true;
      GetIntVec(boi_portint,icom_asyncvector);  { save old interrupt vector }
      SetIntVec(boi_portint,@AsyncInt);         { install AsyncInt vector }
      boi_cmode := com_internal;
      boi_cstr := ' Internal Comm Active';
      Port[PICMSK] := Port[PICMSK] and boi_picmask;  { access 8259A PIC }
      if boi_cascade then
          Port[PIC2MSK] := Port[PIC2MSK] and boi_pic2msk;
      Port[boi_portadd + LCRoff] := Port[boi_portadd + LCRoff] and $7F;
                                            { disable divisor latch register }
      Port[boi_portadd + IERoff] := $01;        { enable interrupts }
      Port[boi_portadd + MCRoff] := $0B;        { set RTS, DTR and OUT2 }
  {   Port[boi_portadd + MSRoff] := $80; }      {}
      inittemp := Port[boi_portadd + LSRoff];   { reset LSR }
      Port[PICCMD] := $20;                     { reset 8259A PIC }
      if boi_cascade then Port[PIC2CMD] := $20 { reset cascade 8259A PIC }
    end;  {* fIntInit,AsyncInit *}

  Procedure FOSSILINIT;
    type
      charray  = array [1..80] of char;

      inforec  = record
          stuff : longint;
          idstr : ^charray
        end;

    var
      fossbuff : ^inforec;

    begin {* FOSSILInit *}
      if foss_init AND $04 = $04 then
        begin
          intexit := exitproc;
          exitproc := @FOSSILEnd
        end;
      boi_cmode := com_fossil;
      ClearInBuffer;
      New(fossbuff);
      foss_regs.AH := $1B;
      foss_regs.CX := 8;
      foss_regs.DX := boi_portnum;
      foss_regs.ES := ptrmask(fossbuff).pseg;
      foss_regs.DI := ptrmask(fossbuff).poff;
      Intr(fossint,foss_regs);
      Move(fossbuff^.idstr^,boi_cstr[2],78);
      boi_cstr[0] := #80;
      boi_cstr[1] := ' ';
      boi_cstr[0] := Chr(Pos(#00,boi_cstr) - 1);
      Dispose(fossbuff)
    end;  {* FOSSILInit *}

  begin {* fIntInit *}
    initerr := 0;
    if foss_init AND $01 = $01 then AsyncInit
    else
      begin
        foss_regs.AH := $04;
        foss_regs.DX := boi_portnum;
        Intr(fossint,foss_regs);
{       fossrev  := regs.bh;           { FOSSIL version implemented        }
{       fossfunc := regs.bl            { highest FOSSIL function supported }
        if foss_regs.AX = $1954 then FOSSILInit
        else if foss_init AND $02 <> $02 then AsyncInit
        else initerr := 31
      end;
    IntInit := initerr
  end;  {* fIntInit *}

begin {* uAsync *}
end.  {* uAsync *}